home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 9
/
Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO
/
010a
/
browsero.zip
/
BROWSER.PRG
next >
Wrap
Text File
|
1993-04-07
|
17KB
|
510 lines
* BROWSER.PRG
*******************************************************************************
* Browser is an Object for browsing & editing any database.
*
*******************************************************************************
// This Object is intended for browing sorted databases. You must specify
// a key to seek in the database or specify a starting record number where
// the whileBlock is first satisfied. It will then browse all records below
// that point until it finds a record that does not satisfy the code block
// or EOF(). The last record satisfying the whileBlock will be considered
// the last record in the browse.
// This "Scoped Browse" approach greatly increases browse times.
// For a more generic filter on a non-indexed field, simply use Clipper's
// SET FILTER TO command and then call this browser without any whileBlock
// specified, or try combining the two if your feeling dangerous...
// Features: 1) Hitting Enter on a field will start editing it, or simply
start typing data into a field & it will put you into the
editor for that field and apply your keystrokes (no need
to press enter to start the field editor).
2) Hit Control-+ (gray plus key) to repeat the data from the
previous record into the currently highlighted field.
3) Control-PageUp & Control-PageDown for Top & Bottom of File.
4) Tab & Shift-Tab to move left/right between fields.
5) You can start the browse either on the first matching key
that you specify or you can feed the browser a record number
to GOTO.
* FileName is the name of the Database to browse (ie: "TRS")
* IndexOrder is the number of the index to order by (ie: 0,1,2,3...)
* Fields is an array of field names to show in the browse
* Pictures is an array of picture masks to use in the Get of the Fields.
* Headers is an array of column headers to show
* Title is a String that will banner across top of browse
* WhileBlock is a code block to evaluate during skipping operations.
* Colors is an array of color strings as follows:
* Colors[1] := Normal Items
* Colors[2] := Highlighted items
* Colors[3] := Items being Edited
* Colors[4] := Title of Browse Screen
* Hooks is a two dimensional array of Hot Key Numbers and the corresponding
* code block containing the function/procedure call(s) you would like to
* be invoked. This is a cleaner way to handle this situation instead of
* SET KEY TO routines. The value returned from your code block will tell
* the browse if it needs to perform some action:
* Return Value Action Requested
* ============ =================================
* 0 Do nothing, simply continue browse
* 1 Refresh the current Row's data only
* 2 Refresh data on whole screen
* 3 Go to top of database, Refresh screen data
* 4 Refresh current Data, move down one row
* 5 Go to the bottom of the database, refresh screen
* 6 Quit the Browser Object & Return from Execute
* 7 Bottom, Pan LeftMost (Home), Move 1 to Right.
* 8 Bottom, Pan LeftMost (Home).
* 9 Bottom, Pan LeftMost (Home), Move 2 to Right.
*
* Note: The first field fed to the browser can not be a memo field, otherwise
* it will not edit the memo field properly.
*
MEMVAR TheKey, TempString
#include "class(y).ch"
#include "inkey.ch"
#include "dbstruct.ch"
CREATE CLASS SBrowse FROM TBrowse
HIDDEN:
VAR AppendMode, OldArea, OldIndex, Changed
METHOD Navigate, EditCell, Stab
EXPORT:
VAR FileName, IndexOrder, Fields, Headers, Pictures
VAR Colors, Hooks, WhileBlock, FirstKey, Title, StartingRec
VAR HasWhileBlock
METHOD Init
METHOD Execute
MESSAGE NewRec IS DEFERRED
END CLASS
*******************************************************************************
* Method Init
*
*******************************************************************************
METHOD Init(nTop, nLeft, nBottom, nRight), (nTop, nLeft, nBottom, nRight)
::FileName := ""
::IndexOrder := 0
::Fields := {}
::Headers := {}
::Pictures := {}
::Title := "SBrowse Screen"
::Colors := {"N/W","N/BG","B/W","B/BG","B/W","B/BG"}
::Hooks := {}
::WhileBlock := {|| .T.}
::HasWhileBlock := .F.
::StartingRec := 0
::FirstKey := ""
::headSep := "═╤═"
::colSep := " │ "
RETURN Self
*******************************************************************************
* METHOD PROCEDURE Execute
* This is the main METHOD called when you want to start 'browsin!
*******************************************************************************
METHOD PROCEDURE Execute
LOCAL I, TempString, Column, Struc, RValue
LOCAL OldArea := 0, OldIndex := 0, HookHit, CallBlock
LOCAL SomeRec, block, TempVar
IF ALIAS()<>::FileName
::OldArea := SELECT()
::OldIndex := INDEXORD()
ENDIF
// set up new area to Browse...
SELECT (::FileName)
SET ORDER TO (::IndexOrder)
// set up browse parameters...
::colorspec := ::Colors[1]+","+::Colors[2]+",W/N,W/N,"+::Colors[3]
// set up the record skipper blocks
::GoTopBlock := {|| BPosWhile("top", ::FirstKey, "", 0, ::HasWhileBlock) }
::GoBottomBlock := {|| BPosWhile("bottom", ::FirstKey) }
::SkipBlock := {|n| BPosWhile("skip", ::FirstKey, ::WhileBlock, n) }
// set up the browse columns
Struc := DBSTRUCT()
FOR I := 1 TO LEN(::Fields)
IF Struc[FIELDPOS(::Fields[I]),DBS_TYPE]="M" // if memo type
TempString := '{|| IF(!EMPTY(' + ::Fields[I] + '),"<Memo>","< >")}'
Column := TBCOLUMNNEW(::Headers[I], &(TempString))
Column:ColorBlock := {|| IF(DELETED(),{3,4},{1,2})}
::ADDCOLUMN(Column)
ELSE
TempString := '{|| '+::FileName+'->'+::Fields[I]+'}'
Column := TBCOLUMNNEW(::Headers[I], &(TempString))
Column:ColorBlock := {|| IF(DELETED(),{3,4},{1,2})}
::ADDCOLUMN(Column)
ENDIF
NEXT I
// draw title for browse
SETCOLOR(::Colors[4])
I := 40 - INT(LEN(::Title)/2)
@ ::nTop-1,I SAY ::Title
IF !EMPTY(::FirstKey)
SEEK (::FirstKey)
IF !FOUND()
IF YesNo("No Records exist, create a new Record?")
::NewRec()
SEEK (::FirstKey) // reposition in database...
ELSE
RETURN // quit executing and return
ENDIF
ENDIF
ELSEIF (::StartingRec<>0)
GOTO (::StartingRec)
ELSE
GO TOP
IF LASTREC()=0
IF YesNo("No Records exist, create a new Record?")
::NewRec()
ELSE
RETURN // quit executing and return
ENDIF
ENDIF
ENDIF
SomeRec := 0
// keep stabalizing and processing navigation keystrokes.
DO WHILE .T.
SET CURSOR OFF
::Stab()
// these next 12 lines had to be added to correct internal re-arrangement
// of records due to index keys changing...
IF (SomeRec<>0)
::GoTop()
::RefreshAll()
::forceStable()
DO WHILE RECNO()<>SomeRec
::Down()
::RefreshCurrent()
::forceStable()
ENDDO
::forceStable()
SomeRec := 0
ENDIF
IF ::Stable // if the Stabalize wasn't interrupted, wait for keystroke
TheKey := INKEY(0)
ENDIF
IF !::Navigate(TheKey)
HookHit := .F.
FOR I := 1 TO LEN(::Hooks)
IF ::Hooks[I,1] = TheKey
HookHit := .T.
CallBlock := ::Hooks[I,2]
ENDIF
NEXT I
DO CASE
CASE TheKey = 400 // K_CTRL_PLUS (gray)
// copy the data from the previous record...
IF BOF()
Beep()
ELSE
SKIP -1
IF ((::HasWhileBlock).AND.(EVAL(::WhileBlock,::FirstKey))).OR. ;
(!::HasWhileBlock)
block := fieldblock(::Fields[::ColPos])
TempVar := EVAL(block)
SKIP +1
EVAL(block,TempVar)
::RefreshCurrent()
ELSE
Beep()
SKIP +1
ENDIF
ENDIF
CASE TheKey = K_ESC
Exit
CASE TheKey = K_ENTER
::EditCell(::Fields[::ColPos], ::Colors[3], ::Pictures[::ColPos])
IF ::Changed
::Changed := .F.
SomeRec := RECNO()
ENDIF
CASE HookHit
RValue := EVAL(CallBlock, Self)
DO CASE
CASE RValue = 1 // Refresh current row only
::RefreshCurrent()
CASE RValue = 2 // Refresh screen only
::RefreshAll()
CASE RValue = 3 // Go to top, refresh
::GoTop()
::RefreshAll()
CASE RValue = 4 // Refresh current, move down one
::RefreshCurrent()
::Down()
CASE RValue = 5 // Go to Bottom, refresh
::GoBottom()
::RefreshAll()
CASE RValue = 6 // Quit the browse object, return
Exit
CASE RValue = 7 // Go Bottom, Pan LeftMost (Home), then Right One
::GoBottom()
::PanHome()
::Right()
::RefreshAll()
CASE RValue = 8 // Go Bottom, Pan LeftMost (Home)
::GoBottom()
::PanHome()
::RefreshAll()
CASE RValue = 9 // Go Bottom, Pan LeftMost (Home), then Right Two
::GoBottom()
::PanHome()
::Right()
::Right()
::RefreshAll()
ENDCASE
OTHERWISE // must have been an ascii key to edit the cell
KEYBOARD CHR(K_ENTER)
KEYBOARD CHR(TheKey)
::EditCell(::Fields[::ColPos], ::Colors[3], ::Pictures[::ColPos])
IF ::Changed
SomeRec := RECNO()
::Changed := .F.
ENDIF
ENDCASE
ENDIF
ENDDO // do while .t. until exit command from <ESC>
IF !EMPTY(::OldArea)
SELECT (::OldArea)
SET ORDER TO (::OldIndex)
ENDIF
SET CURSOR ON
RETURN
*******************************************************************************
* Function BPosWhile
* General Purpose Record Positioning Function with Scoping Condition.
*******************************************************************************
FUNCTION BPosWhile(How, FirstKey, Condition, HowMany, HasWBlk)
// it's assumed that the database is already positioned at the first matching
// key.
LOCAL Actual := 0, SoftStat
DO CASE
CASE How == "top"
IF HasWBlk
SEEK FirstKey
ELSE
GO TOP
ENDIF
CASE How == "bottom"
SoftStat := SET(_SET_SOFTSEEK, .T.)
SEEK (LEFT(FirstKey, LEN(FirstKey) -1) + CHR(255))
SKIP -1
SET(_SET_SOFTSEEK, SoftStat)
CASE How == "skip"
DO CASE
CASE HowMany < 0 // moving backwards
DO WHILE (Actual > HowMany) .AND. (!BOF()) .AND. EVAL(Condition, FirstKey)
SKIP -1
IF (!BOF()) .AND. EVAL(Condition, FirstKey)
Actual--
ENDIF
ENDDO
IF (!EVAL(Condition, FirstKey))
SKIP +1
ENDIF
CASE HowMany > 0 // Moving Forward
DO WHILE (Actual < HowMany) .AND. (!EOF()) .AND. EVAL(Condition, FirstKey)
SKIP +1
IF (!EOF()) .AND. EVAL(Condition, FirstKey)
Actual++
ENDIF
ENDDO
IF EOF() .OR. (!EVAL(Condition, FirstKey))
SKIP -1
ENDIF
OTHERWISE // HowMany = 0 - No Movement requested, re-read current rec
SKIP 0
ENDCASE
ENDCASE
RETURN Actual
*******************************************************************************
* METHOD PROCEDURE Stab stabalizes the given browse object.
*
*******************************************************************************
METHOD PROCEDURE Stab
BEGIN SEQUENCE // define block to exit from if a keystroke is detected...
DO WHILE (!::STABILIZE())
TheKey := INKEY()
IF !EMPTY(TheKey)
BREAK
ENDIF
ENDDO
END SEQUENCE
RETURN
*******************************************************************************
* METHOD FUNCTION Navigate
* will interpret a keystroke and navigate if it understands the command,
* if it doesn't understand, it returns false.
*******************************************************************************
METHOD FUNCTION Navigate(k)
/*
Establish standard navigation keystrokes and the cursor movement
METHOD to associate with each key.
This function gets passed a browse object and a potential
navigation key. If the key is defined it's associated navigation
message is sent to the browse.
Function returns .t. if navigation was handled, .f. if not.
*/
local did := .t.
if k == K_UP
::up()
elseif k == K_DOWN
::down()
elseif k == K_LEFT
::left()
elseif k == K_RIGHT
::right()
elseif k == K_PGUP
::pageUp()
elseif k == K_PGDN
::pageDown()
elseif k == K_CTRL_PGUP
::goTop()
elseif k == K_CTRL_PGDN
::goBottom()
elseif k == K_HOME
::home()
elseif k == K_END
::end()
elseif k == K_CTRL_HOME
::panHome()
elseif k == K_CTRL_END
::panEnd()
elseif k == K_TAB
::Right()
elseif k == K_SH_TAB
::Left()
else
did := .f.
endif
RETURN did
*******************************************************************************
* METHOD FUNCTION EditCell
* Edits any kind of cell thrown to it from a browse...
*******************************************************************************
METHOD FUNCTION EditCell(fieldName, editColor, Pict)
/*
General-purpose browse cell editing function, can handle all
database field types including memo fields. If you want the
edits to "stick" you must assign fieldblock()-style
column:block instance variables. All editing, including
memo-edit, is done within the boundaries of the browse window.
On exit any appropriate browse cursor navigation messages are
passed along. Note: In order to browse a memo field the column
heading must be defined. This function uses the heading to
display a message.
*/
local c, k, clr, crs, rex, block, cell, OldValue
// Retrieve the column object for the current cell.
c := ::getColumn(::colPos)
// Create a field block used to check for a memo field
// and later used to store the edited memo back. It's
// done this way so you can have the browse window display
// a notation like "memo" rather than displaying a small
// hunk of the real memo field.
//
block := fieldblock(fieldName)
// Save old value in a variable to compare later to see if changed...
OldValue := eval(block)
// Can't just "get" a memo, need a memo-edit.
if valtype(eval(block)) = "M"
// Tell the user what's going on.
@ ::nTop, ::nLeft clear to ::nBottom, ::nRight
@ ::nTop, ::nLeft say ;
padc("Memo Edit: Record " +str(recno(),5) ;
+', "'+ c:heading +'" Field', ::nRight -::nLeft)
@ row() +1, ::nLeft say replicate("-", ::nRight -::nLeft +1)
// Turn cursor on and perform the memo edit
// using the specified color.
crs := setcursor(1)
clr := setcolor(editColor)
cell := memoedit(eval(block), ::nTop +2, ::nLeft,;
::nBottom, ::nRight)
setcursor(crs)
setcolor(clr)
// If they didn't abandon the edit, save changes.
// When passed a parameter, fieldblock-style code
// blocks store the value back to the database.
// Handiest darn thing they ever stuck in this language.
if lastkey() <> K_ESC
eval(block, cell)
endif
// We mussed up the entire window, tell TBrowse to
// clean it up.
::configure()
// Regular data type, do a GET/READ.
else
// Pass along any additional keystrokes.
if (lastkey() > K_SPACE) .and. (lastkey() < 256)
keyboard(chr(lastkey()))
endif
// Create a get object for the field.
cell := getnew(row(), col(), ;
block, fieldName, Pict, "W/N,"+editColor)
// Allow up/down to exit the read, and turn the cursor off.
rex := readexit(.t.)
crs := setcursor(1)
SET SCOREBOARD OFF
// Perform the read.
readmodal({cell})
// Restore original cursor and read-exit states.
setcursor(crs)
readexit(rex)
// See if the value was changed
IF eval(block)<>OldValue
::Changed := .T.
ELSE
::Changed := .F.
ENDIF
// We changed the field value and TBrowse doesn't know it.
// So we must force a re-read for the current row.
::refreshCurrent()
::Right()
endif
return nil